suppressMessages({
  suppressWarnings({
    # Définir les noms des tables
    table_names <- c("usagers", "vehicules", "lieux", "caract")
    
    # Définir les URL des fichiers CSV
    urls <- c(
      "https://www.data.gouv.fr/fr/datasets/r/68848e2a-28dd-4efc-9d5f-d512f7dbe66f",
      "https://www.data.gouv.fr/fr/datasets/r/146a42f5-19f0-4b3e-a887-5cd8fbef057b",
      "https://www.data.gouv.fr/fr/datasets/r/8bef19bf-a5e4-46b3-b5f9-a145da4686bc",
      "https://www.data.gouv.fr/fr/datasets/r/104dbb32-704f-4e99-a71e-43563cb604f2"
    )
    
    # Fonction pour télécharger et lire les fichiers CSV
    download_and_read_csv <- function(url) {
      # Télécharger le fichier CSV
      temp_file <- tempfile(fileext = ".csv")
      download.file(url, temp_file, mode = "wb")
    
      # Lire le fichier CSV
      data <- read_csv2(temp_file)
    
      return(data)
    }
    
    # Télécharger et nommer les tables des fichiers CSV
    for (i in 1:length(urls)) {
      assign(table_names[i], download_and_read_csv(urls[i]))  # Nommer les tables selon les spécifications
    }
  })
})
usagers_vehicules <- usagers %>%
  inner_join(vehicules, by = c("Num_Acc", "id_vehicule"))

usagers_vehicules_lieux <- usagers_vehicules %>%
  inner_join(lieux, by = "Num_Acc")
## Warning in inner_join(., lieux, by = "Num_Acc"): Detected an unexpected many-to-many relationship between `x` and `y`.
## ℹ Row 1 of `x` matches multiple rows in `y`.
## ℹ Row 3 of `y` matches multiple rows in `x`.
## ℹ If a many-to-many relationship is expected, set `relationship =
##   "many-to-many"` to silence this warning.
usagers_vehicules_lieux_caract <- usagers_vehicules_lieux %>%
  inner_join(caract, by = "Num_Acc")

merged_data <- usagers_vehicules_lieux_caract
merged_data <- subset(merged_data, grav != 0 & grav!=-1)
merged_data$id_accident <- paste0(merged_data$Num_Acc, merged_data$id_usager)

vroum <- merged_data %>% 
  filter(catv %in% c("7"))
# Reformater Num_Acc pour ne garder que les 6 derniers chiffres
vroum <- vroum %>%
  mutate(Num_Acc = substr(as.character(Num_Acc), nchar(as.character(Num_Acc)) - 5, nchar(as.character(Num_Acc))))
# 1. Créer une nouvelle table avec les colonnes id_usager, Num_Acc et catu
vroum_clean <- vroum %>%
  select(id_usager, Num_Acc, catu) %>%
  distinct()  # Pour supprimer les doublons dans le couple (id_usager, catu)

# 2. Vérifier pour chaque Num_Acc si un piéton (catu == 3) et un conducteur (catu == 1) sont impliqués
# Créer une colonne pour savoir si un accident a un piéton, une voiture ou uniquement des piétons
accident_check <- vroum_clean %>%
  group_by(Num_Acc) %>%
  summarise(
    piéton_present = any(catu == 3),  # Il y a un piéton si catu == 3
    voiture_present = any(catu == 1),  # Il y a une voiture si catu == 1
    only_pietons = all(catu == 3)     # Tous les usagers sont des piétons si catu == 3 pour toutes les lignes
  )

# 3. Filtrer les accidents qui ont à la fois un piéton et un conducteur, ou uniquement des piétons
accidents_to_remove <- accident_check %>%
  filter((piéton_present == TRUE & voiture_present == TRUE) | only_pietons == TRUE)
# 4. Supprimer tous les Num_Acc qui sont dans `accidents_to_remove`
vroum <- vroum %>%
  filter(!Num_Acc %in% accidents_to_remove$Num_Acc)
# Transformation de la colonne hrmn
vroum <- vroum %>%
  mutate(
    # Convertir hrmn en format heures, minutes, secondes
    time = as.POSIXct(hrmn, format = "%H:%M:%S"),
    hour = as.numeric(format(time, "%H")), # Extraire les heures
    minute = as.numeric(format(time, "%M")), # Extraire les minutes
    second = as.numeric(format(time, "%S")) # Extraire les secondes
  ) %>%
  mutate(
    # Arrondir l'heure selon les règles données
    hour_adjusted = ifelse(
      minute > 29 | (minute == 29 & second >= 30), 
      (hour + 1) %% 24,  # Arrondir vers le haut, modulo 24 pour les heures > 23
      hour
    )
  )

# Comptage du nombre d'accidents par heure arrondie
accidents_par_heure <- vroum %>%
  group_by(hour_adjusted) %>%
  summarise(nombre_accidents = n_distinct(Num_Acc)) %>%
  arrange(hour_adjusted)
#on crée une colonne jour 
vroum <- vroum %>%
  mutate(
    date = as.Date(paste0("2023-", mois, "-", jour), format = "%Y-%m-%d"),
    jour_semaine = weekdays(date) # Calculer le jour de la semaine
  )
# 1. Filtrer les données pour exclure les trajets non renseignés (0 et -1)
vroum_filtered <- vroum %>%
  filter(trajet != 0 & trajet != -1)

# 2. Remplacer les valeurs de trajet par leur signification réelle
vroum_filtered <- vroum_filtered %>%
  mutate(trajet = case_when(
    trajet == 1 ~ "Domicile – travail",
    trajet == 2 ~ "Domicile – école",
    trajet == 3 ~ "Courses – achats",
    trajet == 4 ~ "Utilisation professionnelle",
    trajet == 5 ~ "Promenade – loisirs",
    trajet == 9 ~ "Autre",
    TRUE ~ "Inconnu"  # Au cas où
  ))

# 3. Remplacer les valeurs de gravité par leur signification réelle
vroum_filtered <- vroum_filtered %>%
  mutate(grav = case_when(
    grav == 1 ~ "Indemne",
    grav == 2 ~ "Tué",
    grav == 3 ~ "Blessé hospitalisé",
    grav == 4 ~ "Blessé léger",
    TRUE ~ "Inconnu"  # Au cas où
  ))
# 3. S'assurer qu'il n'y a pas de doublons dans les clés (id_usager et trajet)
vroum_filtered_unique <- vroum_filtered %>%
  distinct(id_usager, trajet, .keep_all = TRUE)

# 4. Comptage par combinaison unique d'id_usager, trajet et gravité
grav_trajet_summary <- vroum_filtered_unique %>%
  group_by(id_usager, trajet, grav) %>%
  summarise(count = n(), .groups = 'drop')

# 5. Créer un tableau récapitulatif (pivot)
pivot_table <- grav_trajet_summary %>%
  group_by(grav, trajet) %>%
  summarise(total = sum(count), .groups = 'drop') %>%
  pivot_wider(names_from = trajet, values_from = total, values_fill = list(total = 0))

# 7. Ajouter une colonne "total" pour chaque ligne (somme des différentes gravités)
pivot_table <- pivot_table %>%
  mutate(total = rowSums(select(., -grav), na.rm = TRUE))
# Supprimer les lignes où 'prof' == -1
vroum_type_terrain <- vroum %>%
  filter(prof != -1)

# Vérifier l'unicité du couple id_usager & prof, mais conserver toutes les autres informations
vroum_type_terrain <- vroum_type_terrain %>%
  group_by(id_usager, prof) %>%
  slice(1) %>% # On garde seulement la première occurrence pour chaque couple unique
  ungroup()

# 2. Remplacer les valeurs de 'prof' par leur signification réelle
vroum_type_terrain <- vroum_type_terrain %>%
  mutate(prof = case_when(
    prof == 1 ~ "Plat",
    prof == 2 ~ "Pente",
    prof == 3 ~ "Sommet de côte",
    prof == 4 ~ "Bas de côte",
    TRUE ~ "Inconnu"  # Au cas où
  ))

# 3. Remplacer les valeurs de 'grav' par leur signification réelle
vroum_type_terrain <- vroum_type_terrain %>%
  mutate(grav = case_when(
    grav == 1 ~ "Indemne",
    grav == 2 ~ "Tué",
    grav == 3 ~ "Blessé hospitalisé",
    grav == 4 ~ "Blessé léger",
    TRUE ~ "Inconnu"  # Au cas où
  ))
# 4. Comptage par combinaison unique d'id_usager, trajet et gravité
grav_pente_summary <- vroum_type_terrain %>%
  group_by(id_usager, prof, grav) %>%
  summarise(count = n(), .groups = 'drop')

# 5. Créer un tableau récapitulatif (pivot)
pivot_table_2 <- grav_pente_summary %>%
  group_by(grav, prof) %>%
  summarise(total = sum(count), .groups = 'drop') %>%
  pivot_wider(names_from = grav, values_from = total, values_fill = list(total = 0))

# 7. Ajouter une colonne "total" pour chaque ligne (somme des différentes gravités)
pivot_table_2 <- pivot_table_2 %>%
  mutate(total = rowSums(select(., -prof), na.rm = TRUE))

# 4. Lier le profil de la route à la gravité et créer un tableau de comptage
comptage_grav_prof <- vroum_type_terrain %>%
  group_by(grav, prof) %>%
  summarise(comptage = n(), .groups = "drop")
# 1. Créer le tableau récapitulatif (pivot) avec les totaux par trajet et gravité
pivot_table_2 <- grav_pente_summary %>%
  group_by(prof, grav) %>%
  summarise(total = sum(count), .groups = 'drop') %>%
  pivot_wider(names_from = grav, values_from = total, values_fill = list(total = 0))

# 2. Ajouter une colonne "total" pour chaque ligne (somme des différentes gravités)
pivot_table_2 <- pivot_table_2 %>%
  mutate(total = rowSums(select(., -prof), na.rm = TRUE))

# 3. Calculer les pourcentages par rapport au total de chaque ligne
pivot_table_percentage_2 <- pivot_table_2 %>%
  mutate(across(-c(prof, total), ~ round(. / total,3)*100, .names = " {.col}"))

# 4. Ne conserver que les colonnes "trajet", "total" et les pourcentages
pivot_table_percentage_2 <- pivot_table_percentage_2 %>%
  select(prof, total, starts_with(" "))
# 5. Enlever la colonne "total" et afficher le tableau final avec les pourcentages
pivot_table_percentage_2 <- pivot_table_percentage_2 %>%
  select(-total)  # Retirer la colonne "total"
vroum_grv3 <- vroum %>%
  mutate(
    Gravite = case_when(
      grav == 1 ~ "Indemne",
      grav == 2 ~ "Tué",
      grav == 3 ~ "Hospitalisé",
      grav == 4 ~ "Blessé_Léger",
      TRUE ~ "Autre"  # Si d'autres catégories existent
    )
  )

# Afficher un aperçu des données après recodage
vroum_grv3 <- vroum_grv3 %>%
  mutate(grav = Gravite) %>%
  select(-Gravite)

vroum_place <- vroum_grv3 %>%
  mutate(
    place_recoded = case_when(
      place == 1 ~ "Conducteur",
      place %in% c(2,6) ~ "Avant",
      place %in% c(3, 9) ~ "Arriere_Droite",
      place %in% c(4, 7) ~ "Arriere_Gauche",
      place %in% c(5, 8) ~ "Arriere_Milieu",
    )
  )

# Afficher un aperçu des données après recodage
vroum_place <- vroum_place %>%
  mutate(place = place_recoded) %>%  # Mettre à jour `place`
  select(-place_recoded) %>%         # Supprimer `place_recoded`
  drop_na(place)%>%
  distinct(id_accident, .keep_all = TRUE) 
vroum_grv10 <- vroum %>%
  mutate(
    Gravite = case_when(
      grav == 1 ~ "Indemne",
      grav == 2 ~ "Tué",
      grav == 3 ~ "Hospitalisé",
      grav == 4 ~ "Blessé_Léger",
      TRUE ~ "Autre"  # Si d'autres catégories existent
    )
  )

# Afficher un aperçu des données après recodage
vroum_grv10 <- vroum_grv10 %>%
  mutate(grav = Gravite) %>%
  select(-Gravite)

vroum_lum <- vroum_grv10 %>%
  mutate(
    lumo = case_when(
      lum == 1 ~"Plein jour",
      lum == 2 ~ "Crépuscule ou aube",
      lum == 3 ~ "Nuit sans éclairage public",
      lum == 4 ~ "Nuit avec éclairage public non allumé",
      lum==5 ~ "Nuit avec éclairage public allumé"
    )
  )

# Afficher un aperçu des données après recodage
vroum_lum <- vroum_lum %>%
  mutate(lum = lumo) %>%  # Mettre à jour `place`
  select(-lumo) %>%         # Supprimer `place_recoded`
  drop_na(lum)%>%
  distinct(id_accident, .keep_all = TRUE) 
vroum_grv2 <- vroum %>%
  mutate(
    Gravite = case_when(
      grav == 1 ~ "Indemne",
      grav == 2 ~ "Tué",
      grav == 3 ~ "Hospitalisé",
      grav == 4 ~ "Blessé Léger",
      TRUE ~ "Autre"  # Si d'autres catégories existent
    )
  )

# Afficher un aperçu des données après recodage
vroum_grv2 <- vroum_grv2%>%
  mutate(grav = Gravite) %>%
  select(-Gravite)

vroum_atm <- vroum_grv2 %>%
  mutate(
    atmo = case_when(
      atm == 1 ~ "Normale",
      atm == 2 ~ "Pluie légère",
      atm == 3 ~ "Pluie forte",
      atm == 4 ~ "Neige-grèle",
      atm == 5 ~ "Brouillard-fumé",
      atm == 6 ~ "Vent fort- tempète",
      atm == 7 ~ "Temps éblouissant",
      atm == 8 ~ "Temps couvert",
      atm == 9 ~ "Autres",
    )
  )

vroum_atm <- vroum_atm %>%
  mutate(atm = atmo) %>%         # Renommer la colonne 'atmo' en 'atm'
  select(-atmo) %>%              # Supprimer la colonne 'atmo'
  drop_na(atm) %>%               # Supprimer les lignes où 'atm' est NA
  distinct(id_accident, .keep_all = TRUE)  # Conserver une seule ligne par 'id_accident'
# 1. Construire la colonne date complète si nécessaire
vroum_filtered_unique <- vroum_filtered_unique %>%
  mutate(
    date_complete = as.Date(paste("2023", mois, jour, sep = "-"), format = "%Y-%m-%d")
  )

# 2. Créer une colonne pour le mois complet
vroum_filtered_unique <- vroum_filtered_unique %>%
  mutate(
    mois_complete = as.Date(format(date_complete, "%Y-%m-01"))
  )

# 3. Compter les trajets par type et mois
trajet_par_mois <- vroum_filtered_unique %>%
  group_by(mois_complete, trajet) %>%
  summarise(nombre = n(), .groups = 'drop')

Présentation des données

Notre dashboard permet de regrouper les visualisations statistiques que nous avons réalisé sur la base des accidents corporels de la circulation routière en France pour l’année 2023 rendue publique par l’état sur data.gouv : https://www.data.gouv.fr/fr/datasets/bases-de-donnees-annuelles-des-accidents-corporels-de-la-circulation-routiere-annees-de-2005-a-2023/

Cette première page présente la répartition des accidents dans le temps, dans l’espace, ainsi que les caractéristiques des personnes impliquées.

Etude du Contexte des accidents

Répartition annuelle

# Exemple de DataFrame
vroum_cal <- vroum %>%
  mutate(
    # Créer une colonne de date complète
    date_decl = make_date(year = an, month = mois, day = jour),
    
    # Calculer le jour (numérique)
    jour = day(date_decl),
    
    # Jour de la semaine (nom complet)
    journee = wday(date_decl, label = TRUE, abbr = FALSE),
    
    # Mois (nom complet, non abrégé)
    mois = month(date_decl, label = TRUE, abbr = FALSE),
    
    # Numéro de la semaine dans le mois
    wotm = ceiling(day(date_decl) / 7)
  )


heatmap <- vroum_cal %>% 
  group_by(date = date_decl, journee, jour, mois, annee = 2023, wotm) %>% 
  summarise(nb = n_distinct(Num_Acc))
## `summarise()` has grouped output by 'date', 'journee', 'jour', 'mois', 'annee'.
## You can override using the `.groups` argument.
heatmap <- heatmap %>%
  mutate(journee = factor(journee, levels = c("lundi", "mardi", "mercredi", "jeudi", "vendredi", "samedi", "dimanche")))

# Palette de couleurs
pal <- wes_palette("Zissou1", 100, type = "continuous")
# Ajustement de la mise en page pour afficher tous les mois
ggplot(heatmap, aes(wotm, journee, fill = nb)) + 
  geom_tile(colour = "white") + 
  facet_wrap(~ mois, nrow = 2, scales = "free_x") + # Utilisation de facet_wrap avec 2 lignes
  labs(
       fill = "Nombre d'accident", 
       x = "Semaine du mois", 
       y = "Journée", 
       title = "Nombre d'accident corporelle en 2023"
  ) + 
  scale_fill_gradientn(colours = pal) + 
  theme_bw() +
  theme(
    strip.text = element_text(size = 12, face = "bold"), # Améliorer la lisibilité des titres de facette
    axis.text.x = element_text(angle = 45, hjust = 1) # Inclinaison des labels de l'axe X pour éviter l'encombrement
  )

Répartition horaire

# Transformation de la colonne hrmn
vroum <- vroum %>%
  mutate(
    # Convertir hrmn en format heures, minutes, secondes
    time = as.POSIXct(hrmn, format = "%H:%M:%S"),
    hour = as.numeric(format(time, "%H")), # Extraire les heures
    minute = as.numeric(format(time, "%M")), # Extraire les minutes
    second = as.numeric(format(time, "%S")) # Extraire les secondes
  ) %>%
  mutate(
    # Arrondir l'heure selon les règles données
    hour_adjusted = ifelse(
      minute > 29 | (minute == 29 & second >= 30), 
      (hour + 1) %% 24,  # Arrondir vers le haut, modulo 24 pour les heures > 23
      hour
    )
  )

# Comptage du nombre d'accidents par heure arrondie
accidents_par_heure <- vroum %>%
  group_by(hour_adjusted) %>%
  summarise(nombre_accidents = n_distinct(Num_Acc)) %>%
  arrange(hour_adjusted)

# Graphique en coordonnées polaires avec la palette "Paired"
g_bp.5 <- ggplot(data = accidents_par_heure,
                 aes(x = factor(hour_adjusted), y = nombre_accidents, group = 1)) + 
  geom_point(stat = 'identity', color = brewer.pal(12, "Paired")[2], size = 2) +  # Point avec couleur de la palette "Paired"
  geom_line(color = brewer.pal(12, "Paired")[2], size = 2) +  # Ligne avec couleur de la palette "Paired"
  coord_polar(start = -pi * 1/24) +  # Coordonnées polaires
  labs(
    title = "Décompte des accidents par heure",
    x = "Heure",
    y = "Nombre d'accidents"
  ) +
  theme_bw() +
  theme(
    plot.title = element_text(size = 14, hjust = 0.5),
    axis.title.x = element_text(size = 12),
    axis.title.y = element_text(size = 12),
    axis.text = element_text(size = 10)
  )
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
# Affichage du graphique
g_bp.5

Répartition par sexe

# Exclure les valeurs invalides et calculer l'âge
vroum_sexe <- vroum %>%
  filter(sexe %in% c(1, 2)) %>%  # Garder uniquement les valeurs valides pour sexe
  mutate(age = 2023 - an_nais) %>%  # Calculer l'âge
  filter(!is.na(age))  # Exclure les NA dans les âges

# Regrouper par âge exact et par sexe
pyramide_data <- vroum_sexe %>%
  group_by(age, sexe) %>%
  summarise(nombre = n(), .groups = "drop") %>%
  mutate(nombre = ifelse(sexe == 1, -nombre, nombre)) # Négatif pour les hommes

ggplot(pyramide_data, aes(x = age, y = nombre, fill = factor(sexe))) +
  geom_bar(stat = "identity", width = 1) +
  scale_y_continuous(labels = abs) + # Afficher les valeurs absolues sur l'axe Y
  labs(
    title = "Nombre d'accident en fonction de l'age et du sexe des personnes impliquées",
    x = "Âge",
    y = "Nombre d'accidents",
    fill = "Sexe"
  ) +
  scale_fill_manual(
    values = c("#a6cee3", "#fb9a99"), # Couleur 1 pour hommes (#a6cee3), couleur 5 pour femmes (#fb9a99)
    labels = c("Hommes", "Femmes")
  ) +
  theme_minimal() +
  theme(
    plot.title = element_text(size = 16, hjust = 0.5),
    axis.text.x = element_text(size = 12),
    axis.text.y = element_text(size = 12),
    axis.title.x = element_text(size = 14),
    axis.title.y = element_text(size = 14),
    legend.title = element_text(size = 12),
    legend.text = element_text(size = 10)
  )

# Exclure les valeurs invalides et calculer l'âge
vroum_passager <- vroum %>%
  mutate(
    place_recoded = case_when(
      place == 1 ~ "Conducteur",
      place %in% c(2,3,4,5,6,7,8,9) ~ "Passager"
    )
  )

vroum_passager<-vroum_passager%>%
  drop_na(place_recoded)

# Transformer la base de données en comptant distinctement les accidents
donnees_donut <- vroum_passager %>%
  group_by(place_recoded) %>%
  summarise(count = n_distinct(Num_Acc)) %>%
  ungroup() %>%
  mutate(
    fraction = count / sum(count),
    ymax = cumsum(fraction),
    ymin = c(0, head(ymax, n = -1)),
    labelPosition = (ymax + ymin) / 2,
    label = paste0(place_recoded, "\nAccidents: ", count)
  )

# Créer le graphique en donut
ggplot(donnees_donut, aes(ymax = ymax, ymin = ymin, xmax = 4, xmin = 3, fill = place_recoded)) +
  geom_rect() +
  geom_label(x = 3.5, aes(y = labelPosition, label = label), size = 6) +
  scale_fill_brewer(palette = "Paired") +
  coord_polar(theta = "y") +
  xlim(c(2, 4)) +
  theme_void() +
  theme(legend.position = "none") +
  ggtitle("Répartition des accidents entre conducteurs et passagers")

Répartition géographique

# Calculer le nombre d'accidents par département
accidents_par_dep <- vroum %>%
  group_by(dep) %>%
  summarise(nombre_accidents = n_distinct(Num_Acc))

# Charger la carte des départements
france_departements <- st_read("https://france-geojson.gregoiredavid.fr/repo/departements.geojson", quiet = TRUE)

# Assurez-vous que les codes départements sont comparables (format chaîne de caractères)
accidents_par_dep$dep <- as.character(accidents_par_dep$dep)

# Fusionner les données des accidents avec la carte géographique
france_accidents_map <- france_departements %>%
  left_join(accidents_par_dep, by = c("code" = "dep"))

# Générer une palette limitée aux 6 premières couleurs de "Paired"
paired_colors_limited <- colorRampPalette(brewer.pal(6, "Paired"))(100)

# Créer une heatmap avec leaflet en utilisant "Paired"
leaflet(france_accidents_map) %>%
  addTiles() %>%
  addPolygons(
    fillColor = ~colorNumeric(paired_colors_limited, nombre_accidents)(nombre_accidents),
    weight = 1, color = "white", fillOpacity = 0.7,
    popup = ~paste("Département: ", nom, "<br>",
                   "Nombre d'accidents: ", nombre_accidents)
  ) %>%
  addLegend(
    pal = colorNumeric(paired_colors_limited, france_accidents_map$nombre_accidents),
    values = france_accidents_map$nombre_accidents,
    title = "Nombre d'accidents",
    opacity = 0.7
  )

Analyse des critères qui impactent la gravité

Contexte

Cette seconde page présente une analyse statistique de la gravité de l’incident pour les personnes impliquées selon différents critères.

Répartition géographique

# Calcul des accidents par département et gravité
accidents_par_dep_gravite <- vroum %>%
  group_by(dep, grav) %>%
  summarise(nombre_accidents = n_distinct(id_accident), .groups = "drop")

# Charger les données géographiques des départements français
departements_geojson <- st_read("https://france-geojson.gregoiredavid.fr/repo/departements.geojson", quiet = TRUE)

# Extraire les centroides des départements
departements_geojson <- departements_geojson %>%
  mutate(centroid = st_centroid(geometry)) %>%
  mutate(
    x = st_coordinates(centroid)[, 1],
    y = st_coordinates(centroid)[, 2]
  )

# Définir les couleurs personnalisées
custom_colors <- c(
  "Indemne" = "#FDBF6F", 
  "Blessé léger" = "#FF7F00",
  "Blessé hospitalisé" = "#FB9A99",
  "Tué" = "#E31A1C"
)

# Fonction pour créer une carte Bubble Map pour une gravité spécifique
create_bubble_map <- function(gravite_label, gravite_code, color) {
  # Filtrer les données pour la gravité spécifique
  filtered_data <- accidents_par_dep_gravite %>%
    filter(grav == gravite_code)
  
  # Fusionner les données géographiques avec les données d'accidents
  departements_accidents_map <- departements_geojson %>%
    left_join(filtered_data, by = c("code" = "dep"))
  
  # Créer la carte avec ggplot2
  ggplot(departements_accidents_map) +
    geom_sf(fill = "white", color = "gray", size = 0.2) + # Carte des départements
    geom_point(aes(x = x, y = y, size = nombre_accidents), color = color, alpha = 0.7) + # Bulles
    scale_size_continuous(name = "Nombre d'accidents", range = c(1, 7)) + # Taille des cercles
    theme_void() +
    labs(title = paste(gravite_label)) +
    theme(
      plot.title = element_text(size = 14, face = "bold", hjust = 0.5),
      legend.position = "bottom"
    )
}

# Gravités à mapper
gravites <- list(
  "Indemne" = 1,
  "Blessé léger" = 4,
  "Blessé hospitalisé" = 3,
  "Tué" = 2
)

# Générer les Bubble Maps pour chaque gravité avec les couleurs personnalisées
maps <- mapply(function(label, code, color) {
  create_bubble_map(label, code, custom_colors[label])
}, names(gravites), gravites, custom_colors[names(gravites)], SIMPLIFY = FALSE)

# Organiser les cartes en une disposition 2x2
grid.arrange(grobs = maps, ncol = 2)

Répartition de la gravité des accidents selon le motif de déplacement

# 1. Filtrer les données pour exclure les trajets non renseignés (0 et -1)
vroum_filtered <- vroum %>%
  filter(trajet != 0 & trajet != -1)

# 2. Remplacer les valeurs de trajet par leur signification réelle
vroum_filtered <- vroum_filtered %>%
  mutate(trajet = case_when(
    trajet == 1 ~ "Domicile – travail",
    trajet == 2 ~ "Domicile – école",
    trajet == 3 ~ "Courses – achats",
    trajet == 4 ~ "Utilisation professionnelle",
    trajet == 5 ~ "Promenade – loisirs",
    trajet == 9 ~ "Autre",
    TRUE ~ "Inconnu"  # Au cas où
  ))

# 3. Remplacer les valeurs de gravité par leur signification réelle
vroum_filtered <- vroum_filtered %>%
  mutate(grav = case_when(
    grav == 1 ~ "Indemne",
    grav == 2 ~ "Tué",
    grav == 3 ~ "Blessé hospitalisé",
    grav == 4 ~ "Blessé léger",
    TRUE ~ "Inconnu"  # Au cas où
  ))
# Définir les couleurs personnalisées
custom_colors <- c(
  "#FDBF6F", 
  "#FF7F00",
  "#FB9A99",
  "#E31A1C"
)

# 3. S'assurer qu'il n'y a pas de doublons dans les clés (id_usager et trajet)
vroum_filtered_unique <- vroum_filtered %>%
  distinct(id_usager, trajet, .keep_all = TRUE)

# 4. Comptage par combinaison unique d'id_usager, trajet et gravité
grav_trajet_summary <- vroum_filtered_unique %>%
  group_by(id_usager, trajet, grav) %>%
  summarise(count = n(), .groups = 'drop')

# 1. Créer le tableau récapitulatif (pivot) avec les totaux par trajet et gravité
pivot_table <- grav_trajet_summary %>%
  group_by(trajet, grav) %>%
  summarise(total = sum(count), .groups = 'drop') %>%
  pivot_wider(names_from = grav, values_from = total, values_fill = list(total = 0))

# 2. Ajouter une colonne "total" pour chaque ligne (somme des différentes gravités)
pivot_table <- pivot_table %>%
  mutate(total = rowSums(select(., -trajet), na.rm = TRUE))

# 3. Calculer les pourcentages par rapport au total de chaque ligne
pivot_table_percentage <- pivot_table %>%
  mutate(across(-c(trajet, total), ~ round(. / total, 2), .names = " {.col}"))

# 4. Ne conserver que les colonnes "trajet", "total" et les pourcentages
pivot_table_percentage <- pivot_table_percentage %>%
  select(trajet, total, starts_with(" "))

pivot_table_long <- pivot_table_percentage %>%
  pivot_longer(cols = -trajet, names_to = "grav", values_to = "total") %>%
  filter(grav != "total", trajet != "total")

# Définir les couleurs basées sur la palette "Accent"
accent_colors <- brewer.pal(6, "Dark2")  # Nombre de couleurs = nombre de trajets

highchart() %>%
  hc_chart(type = "column") %>%
  hc_title(text = "Histogramme présentant la répartition (en %) du type de gravité par trajet") %>%
  hc_xAxis(categories = unique(pivot_table_long$trajet)) %>%
  hc_yAxis(title = list(text = "Répartition des accidents (en %)")) %>%
  hc_colors(accent_colors) %>%  # Utilisation des couleurs "Accent"
  hc_add_series(data = pivot_table_long %>% 
                  filter(grav == " Blessé hospitalisé") %>% 
                  group_by(trajet) %>% 
                  summarise(total = sum(total)) %>% 
                  pull(total), name = "Blessé hospitalisé", stack = "gravité",color=custom_colors[3]) %>%
  hc_add_series(data = pivot_table_long %>% 
                  filter(grav == " Blessé léger") %>% 
                  group_by(trajet) %>% 
                  summarise(total = sum(total)) %>% 
                  pull(total), name = "Blessé léger", stack = "gravité",color=custom_colors[2]) %>%
  hc_add_series(data = pivot_table_long %>% 
                  filter(grav == " Tué") %>% 
                  group_by(trajet) %>% 
                  summarise(total = sum(total)) %>% 
                  pull(total), name = "Tué", stack = "gravité",color=custom_colors[4]) %>%
  hc_add_series(data = pivot_table_long %>% 
                  filter(grav == " Indemne") %>% 
                  group_by(trajet) %>% 
                  summarise(total = sum(total)) %>% 
                  pull(total), name = "Indemne", stack = "gravité",color=custom_colors[1])

Conditions de l’accident

Répartition de la gravité des accidents selon les conditions atmosphérique

# Préparer les données avec des proportions
vroum_prop_grid <- vroum_atm %>%
  group_by(atm, grav) %>%
  summarise(count = n(), .groups = "drop") %>%
  group_by(atm) %>%
  mutate(
    proportion = count / sum(count),
    total_squares = round(proportion * 100) # Chaque situation sera divisée en 100 carrés
  ) %>%
  ungroup()

# Corriger pour ne pas dépasser 100 carrés
vroum_prop_grid <- vroum_prop_grid %>%
  group_by(atm) %>%
  mutate(
    diff = sum(total_squares) - 100, # Calculer l'excès de carrés
    total_squares = ifelse(row_number() == n() & diff > 0, total_squares - diff, total_squares) # Réduire l'excès sur la dernière ligne
  ) %>%
  ungroup()

# Créer des positions pour chaque carré
vroum_grid <- vroum_prop_grid %>%
  group_by(atm) %>%
  mutate(
    start = cumsum(lag(total_squares, default = 0)) + 1,
    end = cumsum(total_squares)
  ) %>%
  rowwise() %>%
  mutate(grid = list(seq(start, end))) %>%
  unnest(grid) %>%
  mutate(
    x = (grid - 1) %% 10, # Colonnes pour former une grille de 10x10
    y = (grid - 1) %/% 10 # Lignes pour former une grille de 10x10
  ) %>%
  ungroup()

# Créer le graphique
ggplot(vroum_grid, aes(x = x, y = y, fill = grav)) +
  geom_tile(color = "white") +
  facet_wrap(~ atm, nrow = 2) +
  scale_fill_manual(
    values = c("Indemne" = "#FDBF6F", 
               "Blessé Léger" = "#FF7F00",
               "Hospitalisé" = "#FB9A99",
               "Tué" = "#E31A1C")
  ) +
  coord_fixed() +
  theme_minimal() +
  labs(
    title = "Répartition des accidents par situation atmosphérique et gravité",
    x = NULL, 
    y = NULL,
    fill = "Gravité"
  ) +
  theme(
    strip.text = element_text(face = "bold"),
    axis.text = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank()
  )

# Définir des couleurs personnalisées
custom_colors <- c(
      "Indemne" = "#FDBF6F", 
      "Blessé Léger" = "#FF7F00",
      "Hospitalisé" = "#FB9A99",
      "Tué" = "#E31A1C"
)


# Créer un tableau de comptage par type d'atmosphère et gravité
data_summary <- vroum_atm %>%
  group_by(atm, grav) %>%
  summarise(count = n(), .groups = "drop")  # Compter les accidents par catégorie

# Créer le graphique
plot_horizontal <- ggplot(data_summary, aes(x = count, y = atm, fill = grav)) +
  geom_bar(stat = "identity", position = "stack") + # Barres empilées
  scale_x_continuous(labels = comma_format()) + # Format des nombres avec des séparateurs
  scale_fill_manual(values = custom_colors, name = "Gravité") + # Couleurs personnalisées
  theme_bw() +
  labs(
    title = "Nombre d'accidents par condition atmosphérique et gravité",
    x = "Nombre d'accidents",
    y = "Condition atmosphérique"
  ) +
  theme(
    plot.title = element_text(size = 12, face = "bold", hjust = 0.5),
    axis.text.y = element_text(size = 10),  # Taille des étiquettes sur l'axe Y
    axis.text.x = element_text(size = 10),  # Taille des étiquettes sur l'axe X
    legend.position = "right"
  )

# Afficher le graphique
print(plot_horizontal)

Répartition de la gravité des accidents selon la luminosité

# 1. Filtrer pour enlever les -1 dans les colonnes lum et grav
vroum_lum <- vroum %>%
  filter(lum != -1, grav != -1)  # Exclusion des valeurs -1

# 2. Remplacer les valeurs de lum et grav par leurs libellés
vroum_lum <- vroum_lum %>%
  mutate(
    lum = case_when(
      lum == 1 ~ "Plein jour",
      lum == 2 ~ "Crépuscule ou aube",
      lum == 3 ~ "Nuit sans éclairage public",
      lum == 4 ~ "Nuit avec éclairage public non allumé",
      lum == 5 ~ "Nuit avec éclairage public allumé",
      TRUE ~ "Inconnu"  # Juste au cas où
    ),
    grav = case_when(
      grav == 1 ~ "Indemne",
      grav == 2 ~ "Tué",
      grav == 3 ~ "Blessé hospitalisé",
      grav == 4 ~ "Blessé léger",
      TRUE ~ "Inconnu"  # Sécurité pour valeurs non prévues
    )
  )
# 3. Garder uniquement les lignes distinctes basées sur Num_Acc
vroum_lum <- vroum_lum %>%
  distinct(Num_Acc, .keep_all = TRUE)

pivot_table_lum <- vroum_lum %>%
  group_by(lum, grav) %>%
  summarise(count = n(), .groups = 'drop')

pivot_table_lum <- pivot_table_lum %>%
  group_by(lum) %>%
  mutate(total_lum = sum(count)) %>%
  ungroup() %>%
  mutate(percentage = round(count / total_lum,2) ) # Calcul des pourcentages

# 4. Réorganiser les données en format long
pivot_table_long_lum_2 <- pivot_table_lum %>%
  select(lum, grav, count)  # Garder les colonnes lum, grav, percentage

# Assurez-vous que les couleurs sont définies
custom_colors <- c("#FDBF6F", "#E31A1C", "#FB9A99", "#FF7F00")  # Exemple
# Vérification des catégories uniques pour l'axe X
categories <- unique(pivot_table_long_lum_2$lum)

# Génération du graphe
highchart() %>%
  hc_chart(type = "column") %>%
  hc_title(text = "Nombre d'accidents par types de gravité selon la luminosité") %>%
  hc_xAxis(categories = categories) %>%
  hc_yAxis(title = list(text = "Nombre des accidents")) %>%
  hc_add_series(
    data = pivot_table_long_lum_2 %>% filter(grav == "Indemne") %>% pull(count),
    name = "Indemne",
    stack = "gravité",
    color = custom_colors[1]
  ) %>%
  hc_add_series(
    data = pivot_table_long_lum_2 %>% filter(grav == "Tué") %>% pull(count),
    name = "Tué",
    stack = "gravité",
    color = custom_colors[2]
  ) %>%
  hc_add_series(
    data = pivot_table_long_lum_2 %>% filter(grav == "Blessé hospitalisé") %>% pull(count),
    name = "Blessé hospitalisé",
    stack = "gravité",
    color = custom_colors[3]
  ) %>%
  hc_add_series(
    data = pivot_table_long_lum_2 %>% filter(grav == "Blessé léger") %>% pull(count),
    name = "Blessé léger",
    stack = "gravité",
    color = custom_colors[4]
  ) %>%
  hc_colors(custom_colors)

Répartition de la gravité des accidents selon la catégorie de route

# Préparation des données : Ajout des noms des catégories de route et gravité
catr_labels <- c(
  "1" = "Autoroute",
  "2" = "Route nationale",
  "3" = "Route départementale",
  "4" = "Voie communale",
  "5" = "Hors réseau public",
  "6" = "Parc de stationnement",
  "7" = "Routes de métropole urbaine",
  "9" = "Autre"
)

grav_labels <- c(
  "1" = "Indemne",
  "2" = "Tué",
  "3" = "Blessé hospitalisé",
  "4" = "Blessé léger"
)

data_prepared <- vroum %>%
  count(catr, grav) %>% # Compte les occurrences pour chaque combinaison de catr et grav
  group_by(catr) %>% # Groupement par catégorie de route
  mutate(proportion = n / sum(n)) %>% # Calcul des proportions
  ungroup() %>%
  mutate(
    catr = factor(catr, levels = c(1, 2, 3, 4, 5, 6, 7, 9), labels = catr_labels), # Ajout des noms des catégories de route
    grav = factor(grav, levels = c(1, 2, 3, 4), labels = grav_labels) # Ajout des noms des gravités
  ) %>%
  drop_na(catr)

# Couleurs spécifiques pour les catégories de gravité (numéros 5 à 8 de la palette "Paired")
custom_colors <- c("#FDBF6F", "#E31A1C", "#FB9A99", "#FF7F00") # Paired 5-8

# Graphique 1 : Proportions
plot_proportion <- ggplot(data_prepared, aes(x = catr, y = proportion, fill = grav)) +
  geom_bar(stat = "identity", position = "stack") + # Barres empilées
  scale_y_continuous(labels = scales::percent_format()) + # Affichage en pourcentage
  scale_fill_manual(values = custom_colors, name = "Gravité") +
  theme_bw() +
  labs(
    title = "Proportion des accidents par catégorie de route et gravité",
    x = "Catégorie de route",
    y = "Proportion"
  ) +
  theme(
    plot.title = element_text(size = 8, face = "bold", hjust = 0.5),
    axis.text.x = element_text(angle = 45, hjust = 1), # Rotation des étiquettes de l'axe X
    legend.position = "right"
  )

# Graphique 2 : Nombres absolus
plot_count <- ggplot(data_prepared, aes(x = catr, y = n, fill = grav)) +
  geom_bar(stat = "identity", position = "stack") + # Barres empilées
  scale_y_continuous(labels = scales::comma_format()) + # Affichage des nombres
  scale_fill_manual(values = custom_colors, name = "Gravité") +
  theme_bw() +
  labs(
    title = "Nombre d'accidents par catégorie de route et gravité",
    x = "Catégorie de route",
    y = "Nombre d'accidents"
  ) +
  theme(
    plot.title = element_text(size = 8, face = "bold", hjust = 0.5),
    axis.text.x = element_text(angle = 45, hjust = 1), # Rotation des étiquettes de l'axe X
    legend.position = "right"
  )

# Afficher les graphiques séparément
print(plot_proportion)

print(plot_count)

Répartition de la gravité des accidents selon la vitesse maximale

# 2. Remplacer les valeurs de gravité par leur signification réelle
vroum_filtered_vma <- vroum %>%
  mutate(grav = case_when(
    grav == 1 ~ "Indemne",
    grav == 2 ~ "Tué",
    grav == 3 ~ "Blessé hospitalisé",
    grav == 4 ~ "Blessé léger",
    TRUE ~ "Inconnu"  # Au cas où
  ))%>%
  filter(vma %in% c(30,50,70, 80,90, 110, 130))

# 3. Comptage par combinaison unique de gravité et vma
grav_vma_summary <- vroum_filtered_vma %>%
  group_by(grav, vma) %>%
  summarise(count = n(), .groups = 'drop')

# 4. Créer un tableau récapitulatif (pivot) pour avoir les total d'accidents par gravité et vma
grav_vma_table <- grav_vma_summary %>%
  pivot_wider(names_from = vma, values_from = count, values_fill = list(count = 0))

# 5. Ajouter une colonne "total" pour chaque ligne (somme des différentes vitesses)
grav_vma_table <- grav_vma_table %>%
  mutate(total = rowSums(select(., -grav), na.rm = TRUE))

# Afficher les résultats
print(grav_vma_table)
## # A tibble: 4 × 9
##   grav                `30`  `50`  `70`  `80`  `90` `110` `130` total
##   <chr>              <int> <int> <int> <int> <int> <int> <int> <dbl>
## 1 Blessé hospitalisé   260  1820   764  3431  1022   369   433  8099
## 2 Blessé léger        2473 11869  2697  4067  3501  1676   879 27162
## 3 Indemne             6865 21109  3304  4756  3640  1810  1065 42549
## 4 Tué                   56   353   122   713   229    75    83  1631
# Conversion de grav_vma_table en format long sans la colonne "total"
grav_vma_long <- grav_vma_table %>%
  select(-total) %>%  # Exclut la colonne "total"
  pivot_longer(cols = starts_with("50"):starts_with("130"),  # Sélectionne les colonnes de vitesse
               names_to = "vma",       # La nouvelle colonne pour les valeurs de vitesse
               values_to = "count")    # La nouvelle colonne pour les comptes d'accidents

# Obtenez les couleurs de la palette "Accent" de RColorBrewer
colors_accent <- brewer.pal(7, "Paired")  # 7 couleurs pour chaque VMA

# Créer un graphique avec des barres verticales (une par combinaison gravité-vitesse)
highchart() %>%
  hc_chart(type = "column") %>%
  hc_title(text = "Accidents par Gravité et Vitesse (VMA)") %>%
  hc_xAxis(categories = unique(grav_vma_long$grav), title = list(text = "Gravité")) %>%
  hc_yAxis(title = list(text = "Nombre d'Accidents")) %>%
  hc_plotOptions(column = list(
    dataLabels = list(enabled = FALSE),  # Désactive les labels numériques sur les barres
    pointPadding = 0.2,  # L'espace entre les groupes de barres
    groupPadding = 0.1,  # L'espace entre les barres de la même gravité
    stacking = FALSE,    # Empêche l'empilement des barres
    borderWidth = 1      # Ajoute une bordure pour mieux distinguer les barres
  )) %>%
  hc_add_series(
    data = grav_vma_long %>% filter(vma == 30) %>% pull(count),
    name = "30 km/h",
    color = colors_accent[1]  # Utilise la première couleur de la palette "Accent"
  ) %>%
  hc_add_series(
    data = grav_vma_long %>% filter(vma == 50) %>% pull(count),
    name = "50 km/h",
    color = colors_accent[2]  # Utilise la deuxième couleur de la palette "Accent"
  ) %>%
  hc_add_series(
    data = grav_vma_long %>% filter(vma == 70) %>% pull(count),
    name = "70 km/h",
    color = colors_accent[3]  # Utilise la troisième couleur de la palette "Accent"
  ) %>%
  hc_add_series(
    data = grav_vma_long %>% filter(vma == 80) %>% pull(count),
    name = "80 km/h",
    color = colors_accent[4]  # Utilise la quatrième couleur de la palette "Accent"
  ) %>%
  hc_add_series(
    data = grav_vma_long %>% filter(vma == 90) %>% pull(count),
    name = "90 km/h",
    color = colors_accent[5]  # Utilise la cinquième couleur de la palette "Accent"
  ) %>%
  hc_add_series(
    data = grav_vma_long %>% filter(vma == 110) %>% pull(count),
    name = "110 km/h",
    color = colors_accent[6]  # Utilise la sixième couleur de la palette "Accent"
  ) %>%
  hc_add_series(
    data = grav_vma_long %>% filter(vma == 130) %>% pull(count),
    name = "130 km/h",
    color = colors_accent[7]  # Utilise la septième couleur de la palette "Accent"
  ) %>%
  hc_tooltip(
    shared = FALSE,  # Affiche uniquement la série survolée
    pointFormat = "<b>{point.y}</b> accidents"
  ) %>%
  hc_legend(
    enabled = TRUE,
    title = list(text = "Vitesse (VMA)"),
    align = "center",
    verticalAlign = "top",
    layout = "horizontal"
  )
# Définir les couleurs personnalisées
custom_colors <- c(
  "Indemne" = "#FDBF6F", 
  "Blessé Léger" = "#FF7F00",
  "Hospitalisé" = "#FB9A99",
  "Tué" = "#E31A1C"
)

# Préparer les données
grav_labels <- c(
  "1" = "Indemne",
  "2" = "Tué",
  "3" = "Hospitalisé",
  "4" = "Blessé Léger"
)

filtered_vma <- c(30, 50, 70, 80, 90, 110, 130)

data_prepared <- vroum %>%
  filter(vma %in% filtered_vma) %>%
  group_by(vma, grav) %>%
  summarise(nb = n(), .groups = "drop") %>%
  mutate(
    grav = factor(grav, levels = 1:4, labels = grav_labels), # Ajouter les labels de gravité
    vma = factor(vma, levels = filtered_vma) # S'assurer de l'ordre des vitesses maximales
  )

# Créer le graphique ggstream
ggplot(data_prepared, aes(x = vma, y = nb, fill = grav, group = grav)) +
  geom_stream(type = "proportional", alpha = 0.8) + # Flux proportionnel
  scale_fill_manual(values = custom_colors, name = "Gravité") + # Palette personnalisée
  labs(
    title = "Répartition des accidents par gravité et par vitesse maximale",
    x = "Vitesse maximale (vma)",
    y = "Proportion des accidents"
  ) +
  theme_minimal() +
  theme(
    plot.title = element_text(size = 16, face = "bold", hjust = 0.5),
    axis.text.x = element_text(angle = 45, hjust = 1),
    legend.position = "right"
  ) +
  guides(fill = guide_legend(title.position = "top", title.hjust = 0.5)) # Légende centrée

Répartition de la gravité des accidents selon le type de terrain

# Définir des couleurs personnalisées
custom_colors <- c(
      "Indemne" = "#FDBF6F", 
      "Blessé léger" = "#FF7F00",
      "Blessé hospitalisé" = "#FB9A99",
      "Tué" = "#E31A1C"
)
# Calcul des pourcentages par colonne (prof)
comptage_grav_prof <- comptage_grav_prof %>%
  group_by(prof) %>%
  mutate(pourcentage = comptage / sum(comptage) * 100) %>%
  ungroup()

# Création du graphique à bulles avec ggplot2
bubble_plot <- ggplot(comptage_grav_prof, aes(x = prof, y = grav, size = comptage, color = grav)) +
  geom_point(alpha = 0.8) +  # Alpha pour l'effet de transparence
  geom_text(
    aes(label = paste0(round(pourcentage, 1), "%")), 
    color = "brown",  # Couleur des étiquettes
    size = 4,         # Taille des étiquettes
    vjust = -1        # Positionnement vertical
  ) +
  scale_size_continuous(range = c(10, 50)) +  # Ajuste la taille des bulles
  scale_color_manual(values = custom_colors) +  # Application des couleurs personnalisées
  theme_minimal() +  # Thème épuré
  labs(
    title = "Gravité des Accidents selon le Type de Terrain",
    subtitle = "Pourcentages normalisés par type de terrain",
    x = "Type de Terrain (prof)",
    y = "Gravité de l'Accident",
    size = "Nombre d'Accidents",
    color = "Gravité"
  ) +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1),
    plot.title = element_text(hjust = 0.5, size = 20),
    plot.subtitle = element_text(hjust = 0.5, size = 14)
  )

# Convertir le graphique ggplot en graphique interactif plotly
interactive_plot <- ggplotly(bubble_plot)

interactive_plot

Répartition de la gravité des accidents selon le type d’intersection

# Définir les couleurs personnalisées
custom_colors <- c(
  "Indemne" = "#FDBF6F", 
  "Tué" = "#E31A1C",
  "Blessé hospitalisé" = "#FB9A99",
  "Blessé léger" = "#FF7F00"
)

# Préparation des données : noms des intersections et gravité
intersection_labels <- c(
  "1" = "Hors intersection",
  "2" = "Intersection en X",
  "3" = "Intersection en T",
  "4" = "Intersection en Y",
  "5" = "Intersection à plus de 4 branches",
  "6" = "Giratoire",
  "7" = "Place",
  "8" = "Passage à niveau",
  "9" = "Autre intersection"
)

grav_labels <- c(
  "1" = "Indemne",
  "2" = "Tué",
  "3" = "Blessé hospitalisé",
  "4" = "Blessé léger"
)

# Préparer les données pour les graphiques
data_prepared <- vroum %>%
  count(int, grav) %>% # Compte les occurrences pour chaque combinaison de int et grav
  group_by(int) %>% # Groupement par type d’intersection
  mutate(proportion = n / sum(n)) %>% # Calcul des proportions
  ungroup() %>%
  mutate(
    int = factor(int, levels = 1:9, labels = intersection_labels), # Ajout des noms des intersections
    grav = factor(grav, levels = 1:4, labels = grav_labels) # Ajout des noms des gravités
  ) %>%
  drop_na(int)

# Graphique 1 : Proportion
plot_proportion <- ggplot(data_prepared, aes(y = int, x = proportion, fill = grav)) +
  geom_bar(stat = "identity", position = "stack") + # Barres empilées
  scale_x_continuous(labels = percent_format()) + # Affichage en pourcentage
  scale_fill_manual(values = custom_colors, name = "Gravité") + # Couleurs personnalisées
  theme_bw() +
  labs(
    title = "Proportion des accidents par type d'intersection et gravité",
    x = "Proportion",
    y = "Type d'intersection"
  ) +
  theme(
    plot.title = element_text(size = 16, face = "bold", hjust = 0.5),
    axis.text.y = element_text(size = 10),
    legend.position = "right"
  )

# Graphique 2 : Nombre absolu
plot_count <- ggplot(data_prepared, aes(y = int, x = n, fill = grav)) +
  geom_bar(stat = "identity", position = "stack") + # Barres empilées
  scale_x_continuous(labels = comma_format()) + # Affichage des nombres
  scale_fill_manual(values = custom_colors, name = "Gravité") + # Couleurs personnalisées
  theme_bw() +
  labs(
    title = "Nombre d'accidents par type d'intersection et gravité",
    x = "Nombre d'accidents",
    y = "Type d'intersection"
  ) +
  theme(
    plot.title = element_text(size = 16, face = "bold", hjust = 0.5),
    axis.text.y = element_text(size = 10),
    legend.position = "right"
  )

# Afficher les graphiques séparément
print(plot_proportion)

print(plot_count)

Répartition de la gravité des accidents selon le type de courbe

# Définir les couleurs personnalisées
custom_colors <- c(
  "Indemne" = "#FDBF6F", 
  "Tué" = "#E31A1C",
  "Blessé hospitalisé" = "#FB9A99",
  "Blessé léger" = "#FF7F00"
)

# 1. Filtrer les données pour exclure les lignes où plan == -1
vroum_plan <- vroum %>%
  filter(plan != -1)  # Supprime les lignes "Non renseigné"

# 2. Remplacer les valeurs de 'plan' par les descriptions avec leurs numéros
vroum_plan <- vroum_plan %>%
  mutate(plan = case_when(
    plan == 1 ~ "Partie rectiligne",
    plan == 2 ~ "En courbe à gauche",
    plan == 3 ~ "En courbe à droite",
    plan == 4 ~ "En « S »",
    TRUE      ~ as.character(plan)
  ))

# 3. Remplacer les valeurs de 'grav' par les descriptions avec leurs numéros
vroum_plan <- vroum_plan %>%
  mutate(grav = case_when(
    grav == 1 ~ "Indemne",
    grav == 2 ~ "Tué",
    grav == 3 ~ "Blessé hospitalisé",
    grav == 4 ~ "Blessé léger",
    TRUE      ~ as.character(grav)
  ))
# Calculer le total des accidents pour chaque type de plan
totals_by_plan <- vroum_plan %>%
  group_by(plan) %>%
  summarise(total_plan = n(), .groups = 'drop')

# Calculer les pourcentages pour chaque gravité par type de plan
vroum_plan_percentages <- vroum_plan %>%
  group_by(plan, grav) %>%
  summarise(comptage = n(), .groups = 'drop') %>%
  left_join(totals_by_plan, by = "plan") %>%
  mutate(percentage = round((comptage / total_plan) * 100, 1)) %>%
  ungroup()

# Créer le graphique à bulles avec les pourcentages normalisés et étiquettes en marron
bubble_plot_with_brown_labels <- ggplot(vroum_plan_percentages, aes(x = plan, y = grav, size = comptage, color = grav)) +
  geom_point(alpha = 0.8) +
  geom_text(aes(label = paste0(percentage, "%")), vjust = -1.5, size = 3, color = "brown") + # Ajouter les étiquettes avec couleur marron
  scale_size_continuous(range = c(5, 40)) +
  scale_color_manual(values = custom_colors, name = "Gravité") + # Application des couleurs personnalisées
  theme_minimal() +
  labs(
    title = "Répartition des Accidents selon le Tracé en Plan",
    x = "Type de Tracé en Plan",
    y = "Gravité de l'Accident",
    size = "Nombre d'Accidents",
    color = "Gravité"
  ) +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1),
    plot.title = element_text(hjust = 0.5, size = 20)
  )

# Convertir en graphique interactif avec plotly
interactive_bubble_plot_with_brown_labels <- ggplotly(bubble_plot_with_brown_labels)

# Afficher le graphique interactif
interactive_bubble_plot_with_brown_labels

Répartition de la gravité selon la place dans le véhicule

# Résumer les données
sankey <- vroum_place %>%
  group_by(Place = place, Gravite = grav) %>%
  summarise(nb = n_distinct(id_accident), .groups = "drop")  # Compter les Num_Acc

# Création des nœuds
nodes <- data.frame(name = unique(c(as.character(sankey$Place), as.character(sankey$Gravite))))

# Création des liens avec des indices source/cible
sankey <- sankey %>%
  mutate(
    IDsource = match(Place, nodes$name) - 1,
    IDtarget = match(Gravite, nodes$name) - 1,
    LinkGroup = Gravite  # Utiliser `Gravite` pour grouper les fils (cible)
  )

# Définir les couleurs spécifiques pour les nœuds
# Palette "Paired"
paired_colors <- brewer.pal(12, "Paired")

# Associer les couleurs spécifiées pour chaque catégorie
node_color_map <- data.frame(
  name = c("Conducteur", "Avant", "Arriere_Droite", "Arriere_Gauche", "Arriere_Milieu",
           "Indemne", "Tué", "Hospitalisé", "Blessé_Léger"),
  color = c(
    paired_colors[1],  # Conducteur
    paired_colors[2],  # Avant
    paired_colors[3],  # Arrière Droite
    paired_colors[4],  # Arrière Gauche
    paired_colors[10], # Arrière Milieu
    paired_colors[7],  # Indemne
    paired_colors[6],  # Tué
    paired_colors[5],  # Hospitalisé
    paired_colors[8]   # Blessé Léger
  )
)

# Ajouter les couleurs au dataframe des nœuds
nodes <- nodes %>%
  left_join(node_color_map, by = "name")

# Fonction JavaScript pour appliquer les couleurs des nœuds
colourScale <- JS(
  paste0(
    "d3.scaleOrdinal()
       .domain([", paste(shQuote(nodes$name), collapse = ", "), "])
       .range([", paste(shQuote(nodes$color), collapse = ", "), "])"
  )
)

# Créer le graphique Sankey
sankeyGraph <- sankeyNetwork(
  Links = sankey,              # Liens
  Nodes = nodes,               # Nœuds
  Source = "IDsource",         # Indices source
  Target = "IDtarget",         # Indices cible
  Value = "nb",                # Poids des liens
  NodeID = "name",             # Nom des nœuds
  LinkGroup = "LinkGroup",     # Groupes pour les fils
  fontSize = 12,               # Taille de police
  nodeWidth = 30,              # Largeur des nœuds
  colourScale = colourScale    # Échelle de couleurs JS
)
## Links is a tbl_df. Converting to a plain data frame.
# Afficher le graphique
sankeyGraph
# Step 1: Prepare data with proportions
vroum_prop_grid <- vroum_place %>%
  group_by(place, grav) %>%
  summarise(count = n(), .groups = "drop") %>%
  group_by(place) %>%
  mutate(
    proportion = count / sum(count),
    total_squares = floor(proportion * 100) # Use floor instead of round to prevent overflow
  ) %>%
  ungroup()

# Step 2: Correct for leftover squares
vroum_prop_grid <- vroum_prop_grid %>%
  group_by(place) %>%
  mutate(
    total_assigned = sum(total_squares),
    leftover = 100 - total_assigned, # Calculate leftover squares
    total_squares = ifelse(row_number() <= leftover, total_squares + 1, total_squares) # Distribute leftover squares
  ) %>%
  ungroup()

# Step 3: Create grid positions for tiles
vroum_grid <- vroum_prop_grid %>%
  group_by(place) %>%
  mutate(
    start = cumsum(lag(total_squares, default = 0)) + 1,
    end = cumsum(total_squares)
  ) %>%
  rowwise() %>%
  mutate(grid = list(seq(start, end))) %>%
  unnest(grid) %>%
  mutate(
    x = (grid - 1) %% 10, # Columns for a 10x10 grid
    y = (grid - 1) %/% 10 # Rows for a 10x10 grid
  ) %>%
  ungroup()

# Step 4: Create the plot
ggplot(vroum_grid, aes(x = x, y = y, fill = grav)) +
  geom_tile(color = "white") +
  facet_wrap(~ place, nrow = 2) +
  scale_fill_manual(
    values = c("Indemne" = "#FDBF6F", 
               "Blessé_Léger" = "#FF7F00",
               "Hospitalisé" = "#FB9A99",
               "Tué" = "#E31A1C")
  ) +
  coord_fixed() +
  theme_minimal() +
  labs(
    title = "Répartition des accidents selon la place dans le véhicule",
    x = NULL, 
    y = NULL,
    fill = "Gravité"
  ) +
  theme(
    strip.text = element_text(face = "bold"),
    axis.text = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank()
  )

Répartition de la gravité des accidents par zone de choc sur la voiture

library(ggplot2)
library(ggridges)
library(dplyr)

# Définir les couleurs personnalisées
custom_colors <- c(
  "Indemne" = "#FDBF6F", 
  "Blessé Léger" = "#FF7F00",
  "Hospitalisé" = "#FB9A99",
  "Tué" = "#E31A1C"
)

# Préparer les données pour le graphique
gravites_labels <- c(
  "Indemne", "Tué", "Hospitalisé", "Blessé Léger"
)

choc_labels <- c(
  "Avant", "Avant droit", "Avant gauche", "Arrière",
  "Arrière droit", "Arrière gauche", "Côté droit",
  "Côté gauche", "Chocs multiples"
)

# Préparer les données pour le graphique
gravite_choc_data <- vroum %>%
  filter(grav >= 1 & grav <= 4 & choc >= 1 & choc <= 9) %>%
  mutate(
    grav_label = factor(grav, levels = 1:4, labels = gravites_labels),
    choc_label = factor(choc, levels = 1:9, labels = choc_labels)
  ) %>%
  count(choc_label, grav_label) %>%
  group_by(choc_label) %>%
  mutate(percentage = n / sum(n) * 100) # Calcul du pourcentage

# Créer un graphique en rose des vents
ggplot(gravite_choc_data, aes(x = choc_label, y = percentage, fill = grav_label)) +
  geom_bar(stat = "identity", position = "stack", width = 1, color = "black") +
  coord_polar(theta = "x") + # Transformation en graphique polaire
  scale_fill_manual(
    values = custom_colors, # Utiliser les couleurs personnalisées
    name = "Gravité"
  ) +
  labs(
    title = "",
    x = "",
    y = "Pourcentage",
    fill = "Gravité"
  ) +
  theme_minimal(base_size = 14) +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1), # Rotation des étiquettes de l'axe X
    plot.title = element_text(hjust = 0.5, face = "bold"), # Centrer le titre
    legend.position = "right" # Position de la légende
  )

Page 3 : Analyse décès

Analyse spécifique aux décès

Décès par âge et sexe

# Calcul de l'âge à partir de l'année de naissance
vroum_bal <- vroum %>%
  mutate(age = 2023 - an_nais) %>%  # Calculer l'âge
  filter(age >= 0 & age <= 120 & grav == 2)  # Filtrer les âges aberrants et condition grav == 2

# Graphique empilé (bar chart)
stacked_bar <- ggplot(vroum_bal, aes(x = age, fill = as.factor(sexe))) +
  geom_bar(position = "stack") +  # Barres empilées
  labs(
    x = "Âge (années)",
    y = "Nombre d'usagers",
    fill = "Sexe",
    title = ""
  ) +
  scale_fill_manual(
    values = c("1" = "#a6cee3", "2" = "#fb9a99"),
    labels = c("1" = "Masculin", "2" = "Féminin")
  ) +
  theme_minimal()

# Préparer les données pour le camembert
pie_data <- vroum_bal %>%
  group_by(sexe) %>%
  summarise(count = n()) %>%
  mutate(percentage = count / sum(count) * 100)  # Calculer les pourcentages

# Camembert (pie chart)
pie_chart <- ggplot(pie_data, aes(x = "", y = count, fill = as.factor(sexe))) +
  geom_bar(stat = "identity", width = 1) +
  coord_polar("y") +
  geom_text(aes(label = paste0(round(percentage, 1), "%")), 
            position = position_stack(vjust = 0.5), size = 4) +
  labs(
    fill = "Sexe",
    title = ""
  ) +
  scale_fill_manual(
    values = c("1" = "#a6cee3", "2" = "#fb9a99"),
    labels = c("1" = "Masculin", "2" = "Féminin")
  ) +
  theme_void() +
  theme(legend.position = "bottom")

# Assembler les graphiques avec gridExtra sur une même ligne
grid.arrange(
  stacked_bar, 
  pie_chart, 
  ncol = 2,  # Deux colonnes
  widths = c(2, 0.5)  # Taille relative : le graphique empilé deux fois plus large
)

Décès par zone de choc

# Calcul des décès et pourcentages
death_counts <- vroum %>%
  filter(grav == 2 & choc != -1 & choc != 0) %>%
  count(choc) %>%
  complete(choc = 1:9, fill = list(n = 0)) %>%
  mutate(
    percentage = n / sum(n) * 100,
    choc_label = factor(choc, levels = 1:9, labels = c(
      "Avant", "Avant droit", "Avant gauche", "Arrière",
      "Arrière droit", "Arrière gauche", "Côté droit",
      "Côté gauche", "Chocs multiples"
    ))
  )

# Définir les positions pour les zones de choc
positions <- data.frame(
  choc = 1:9,
  x = c(90, 80, 80, 0, 3, 3, 45, 45, 45),
  y = c(50, 70, 30, 50, 70, 30, 72, 23, 10)
)

# Fusionner les positions et les données des décès
death_counts <- death_counts %>%
  left_join(positions, by = "choc")

# Charger l'image de la voiture
car_image <- png::readPNG("car_image.png") # Remplacez par le chemin réel de votre image
car_image_grob <- rasterGrob(car_image, interpolate = TRUE)

# Créer le graphique sans légende pour les zones de choc
ggplot(death_counts, aes(x = x, y = y)) +
  annotation_custom(car_image_grob, xmin = 0, xmax = 100, ymin = 0, ymax = 100) +
  geom_point(
    aes(size = n, fill = factor(choc)), # Couleurs pour chaque choc
    shape = 21,
    color = "black",
    alpha = 0.8
  ) +
  geom_text(
    aes(label = paste0(choc_label, "\n", n, " décès\n(", round(percentage, 1), "%)")),
    vjust = 0.5, hjust = 0.5, size = 3.5, color = "black", fontface = "bold"
  ) +
  scale_size_continuous(
    range = c(5, 25), # Ajustement de l'échelle des tailles
    name = "Nombre de décès"
  ) +
  scale_fill_brewer(
    palette = "Paired", # Utilisation de la palette "Paired"
    name = "Zone de choc",
    guide = "none" # Suppression de la légende des zones
  ) +
  theme_void() + # Suppression des axes et grilles
  theme(
    plot.title = element_text(face = "bold", size = 14, hjust = 0.5),
    legend.position = "right", # Légende uniquement pour la taille des cercles
    legend.title = element_text(size = 10),
    legend.text = element_text(size = 8)
  ) +
  coord_fixed(ratio = 1) + # Maintenir les proportions
  labs(
    title = "Répartition des décès par zone de choc"
  )

Répartition géographique des décès

vroum_grv6 <- vroum %>%
  mutate(
    Gravite = case_when(
      grav == 2 ~ "Tué"
      )
  )

# Afficher un aperçu des données après recodage
vroum_grv6 <- vroum_grv6 %>%
  mutate(grav = Gravite) %>%
  select(-Gravite)%>%
  drop_na(grav)

## Remove NA
df_map_dyn <- vroum_grv6 %>%
  filter(vroum_grv6$lat != 0 & vroum_grv6$long !=0) %>%
    distinct(id_accident, .keep_all = TRUE)  # Conserver une seule ligne par 'id_accident'

# Transformer les données en spatial
mymap <- st_as_sf(df_map_dyn[1:1000, ], coords = c("long", "lat"), 
                  crs = 4326,
                  na.fail = FALSE)

# Créer une palette de couleurs unique pour chaque catégorie de gravité
palette_gravite <- c(
  "Tué" = "#E31A1C"
)

# Utiliser mapview pour afficher avec une couleur par gravité
mapview(mymap, cex = 2, layer.name = "Gravité",
        zcol = "grav",  # La colonne qui définit les catégories
        col.regions = palette_gravite,  # Appliquer la palette de couleurs
        legend = TRUE,
        map.types = "OpenStreetMap")

Analyse corrélation décès port de la ceinture

# Filtrer les données et créer des colonnes supplémentaires
data_no_belt <- vroum %>%
  mutate(
    no_belt = !(secu1 == 1 | secu2 == 1 | secu3 == 1), # Vérifie l'absence de ceinture
    grav_category = case_when(
      grav == 2 ~ "Tués",
      grav %in% c(1, 3, 4) ~ "Non tués"
    ),
    passenger_position = case_when(
      place %in% c(1, 2, 6) ~ "Avant", # Passagers avant
      TRUE ~ "Arrière"                # Passagers arrière
    )
  ) %>%
  filter(!is.na(grav_category) & !is.na(passenger_position)) # Exclure les valeurs non catégorisées

# Calcul des pourcentages par groupe et position
percentages <- data_no_belt %>%
  group_by(grav_category, passenger_position) %>%
  summarise(
    total = n(),  # Total dans chaque groupe
    no_belt_count = sum(no_belt),  # Nombre de personnes sans ceinture
    .groups = "drop"
  ) %>%
  mutate(
    no_belt_percentage = (no_belt_count / total) * 100  # Calcul du pourcentage
  )

# Créer un graphique avec étiquettes
ggplot(percentages, aes(x = passenger_position, y = no_belt_percentage, fill = grav_category)) +
  geom_bar(stat = "identity", position = "dodge", width = 0.7) + # Position "dodge" pour distinguer les gravités
  geom_text(
    aes(
      label = paste0(no_belt_count, " (", round(no_belt_percentage, 1), "%)"),
      y = no_belt_percentage + 2 # Décalage pour positionner l'étiquette au-dessus des barres
    ),
    position = position_dodge(width = 0.7), size = 3.5, color = "black"
  ) +
  labs(
    title = "",
    x = "Position dans le véhicule",
    y = "Pourcentage d'usagers sans ceinture",
    fill = "Gravité"
  ) +
  scale_fill_manual(values = c("Tués" = "#E31A1C", "Non tués" = "#fb9a99")) +
  theme_minimal() +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1) # Incliner les étiquettes
  )